package require wt::server
package require wt::util

namespace eval ::wt::fileBrowser:: {
  variable pkgDir
  variable loadedTypes 0
}

proc ::wt::fileBrowser::init {} {
  variable path
  set path ""

  variable sysRoot
  set sysRoot ""

  variable sysPath
  set sysPath ""

  variable tailName
  set tailName ""

  variable fixedTailName
  set fixedTailName ""

  variable extension
  set extension ""

  variable fixedExtension
  set fixedExtension ""

  variable baseUrl
  set baseUrl ""

  variable useDirectUrl
  set useDirectUrl 1

  variable loadedTypes
  if {!$loadedTypes} {
    loadTypes
  }

  variable extensionHandlers
  array unset extensionHandlers

  variable textExtensions
  foreach x [array names textExtensions] {
    set extensionHandlers($x) printSource
  }

  variable patternHandlers
  array unset patternHandlers

  variable dirEntries
  array unset dirEntries

  variable elementProps
  set elementProps [table create]

  variable generalInfo
  set generalInfo {}

  variable generalStyle
  set generalStyle "font-size: 10px;"

  variable elementHead
  set elementHead ""

  variable elementContent
  set elementContent ""

  variable viewHtml
  set viewHtml ""
}

proc ::wt::fileBrowser::printView {userPath userSysRoot userBaseUrl} {
  variable path
  set path $userPath
  if {[regexp {\.\.|[\:\|<>]} $path]} {
    error "Invalid path."
  }
  set path [file join / $path]

  variable sysRoot
  set sysRoot $userSysRoot

  variable sysPath
  set sysPath [sysPath $path]

  variable tailName
  set tailName [file tail $sysPath]

  variable fixedTailName
  set fixedTailName [fixBackupName $tailName]

  variable extension
  set extension [extension $tailName]

  variable fixedExtension
  set fixedExtension [extension $fixedTailName]

  variable baseUrl
  set baseUrl $userBaseUrl

  # List parent directory

  set treeHtml [printTree]

  # Display current element

  file stat $sysPath stat
  variable elementProps
  foreach k [array names stat] {
    table set elementProps $k $stat($k)
  }

  if {[file isdir $sysPath]} {
    printDir
  } else {
    printFile
  }

  variable elementHead
  variable elementContent
  set content "${elementHead}${elementContent}"

  variable viewHtml

  set viewHtml "\
<table cellpadding=0 cellspacing=0 border=0>
  <tr valign=top>
    <td>$treeHtml</td>
    <td style=\"padding-left: 25px;\">$content</td>
  </tr>
</table>
"
}

proc ::wt::fileBrowser::printTree {} {
  variable path
  set parentPath [file dirname $path]
  if {$parentPath == "."} {
    set parentPath "/"
  }
  set parentSysPath [sysPath $parentPath]

  if {![file isdir $parentSysPath]} {
    error "Failed to get parent directory."
  }

  set tail [file tail $parentPath]
  if {$tail == ""} {
    set tail /
  }
  set label [shortenName $tail 20]
  set url [pathUrl $parentPath dir]

  set buf ""
  append buf "\[<a href=\"[::wt::web::htmlEncode $url]\">"
  append buf "[::wt::web::htmlEncode $label]</a>\]<br>\n"

  variable dirEntries
  set entries [listDir $parentSysPath]

  variable tailName
  set tail $tailName
  if {$tail == ""} {
    set tail "."
  }

  variable elementProps

  foreach entry $entries {
    set name [table get $entry name]
    set dirEntries($name) $entry
    if {$name == $tail} {
      set elementProps $entry
    }
    if {$name == "." || $name == ".."} {
      continue
    }
    set entryPath [file join $parentPath $name]
    set type [table get $entry type]
    set url [pathUrl $entryPath $type]
    set label [shortenName $name 20]
    if {$type == "directory"} {
      append label "/"
    }
    append buf "<a href=\"[::wt::web::htmlEncode $url]\">"
    append buf "[::wt::web::htmlEncode $label]</a><br>\n"
  }

  return $buf
}

proc ::wt::fileBrowser::printGeneralInfo {} {
  variable generalInfo
  set len [llength $generalInfo]
  set buf ""

  set headers {}
  set vals {}

  for {set i 0} {$i < $len} {incr i} {
    set item [lindex $generalInfo $i]
    set style "font-size: 10px"
    if {$i} {
      append style "; padding-left: 10px"
    }
    set alignStr ""
    if {[table get $item alignment] != ""} {
      set alignStr "align=\"[table get $item alignment]\" "
    }
    lappend headers \
      "<td style=\"$style\"><b>[table get $item label]</b></td>"
    set val "<td ${alignStr}style=\"$style\">"
    append val "[table get $item value]</td>"
    lappend vals $val
  }

  set buf "<table cellpadding=0 cellspacing=0 border=0>\n"
  append buf "<tr valign=top>\n"
  foreach header $headers {
    append buf "$header\n"
  }
  append buf "</tr>\n"
  append buf "<tr valign=top>\n"
  foreach val $vals {
    append buf "$val\n"
  }
  append buf "</tr>\n"
  append buf "</table>"

  return $buf
}

proc ::wt::fileBrowser::printDir {} {
  variable sysPath
  set entries [listDir $sysPath]

  set style "font-weight: bold; font-size: 12px;"
  append ls "\
<table cellpadding=3 cellspacing=1 border=0 bgcolor=black width=550>
<tr valign=top>
  <td bgcolor=#cccccc style=\"$style\">Name</td>
  <td bgcolor=#cccccc style=\"$style\">Size</td>
  <td bgcolor=#cccccc style=\"$style\">Modified</td>
  <td bgcolor=#cccccc style=\"$style\">Owner</td>
</tr>
"

  variable path
  set i 0

  foreach entry $entries {
    set name [table get $entry name]
    if {$name == "." || $name == ".."} {
      continue
    }
    set entryPath [file join $path $name]
    set type [table get $entry type]
    set url [pathUrl $entryPath $type]
    set label [shortenName $name 20]
    set type [table get $entry type]
    if {$type == "directory"} {
      append label "/"
    }
    set time [table get $entry modifiedTime]
    set timeStr [clock format $time -format "%Y/%m/%d %H:%M:%S"]
    set sizeStr [commify [formatMemSize [table get $entry size]]]
    set owner [table get $entry owner]

    append ls "<tr valign=top>
<td bgcolor=white><a href=\"[::wt::web::htmlEncode $url]\"
  >[::wt::web::htmlEncode $label]</a></td>
<td bgcolor=white align=right>[::wt::web::htmlEncode $sizeStr]</td>
<td bgcolor=white
  >[::wt::web::htmlEncode $timeStr]</td>
<td bgcolor=white>[::wt::web::htmlEncode $owner]</td>
</tr>
"
    incr i
  }

  append ls "</table>"
  variable elementContent
  set elementContent $ls

  variable elementHead
  append elementHead "<b>Directory:</b> "
  variable path
  append elementHead [printPathLinks $path directory]
  append elementHead "<br><br style=\"line-height: 8px;\">"

  addToGeneralInfo Items $i right
  addBasicInfo
  append elementHead [printGeneralInfo]
  append elementHead "<br style=\"line-height: 8px;\">"
}

proc ::wt::fileBrowser::printFile {} {
  variable sysPath
  set handler [viewHandler $sysPath]

  variable elementContent
  if {$handler != ""} {
    $handler
  } else {
    defaultPrintFile
  }

  variable elementHead
  append elementHead "<b>File:</b> "
  variable path
  append elementHead [printPathLinks $path file]
  append elementHead "<br><br style=\"line-height: 8px;\">"

  addBasicInfo
  append elementHead [printGeneralInfo]
  append elementHead "<br style=\"line-height: 8px;\">"
}

proc ::wt::fileBrowser::printSource {} {
  variable sysPath
  set fd [open $sysPath]
  set buf [read $fd]
  set lines [split $buf "\n"]
  set n [llength $lines]
  set buf "<table cellpadding=0 cellspacing=0 border=0>\n"

  set i 0
  foreach line $lines {
    set line [string map [list "\r" ""] $line]
    if {$i && $i == [expr $n - 1] && $line == ""} {
      break
    }
    set idx [format %0#4s [expr $i + 1]]
    append buf "<tr>
<td align=right style=\"font-family: courier; font-size: 10px;\">$idx</td>
<td style=\"padding-left: 19px;\"><pre
  style=\"font-family: courier; margin: 0; padding: 0;
  font-size: 10px;\">[::wt::web::htmlEncode $line]</pre></td>
</tr>"
    incr i
  }

  append buf "</table>\n"

  variable elementContent
  set elementContent $buf

  addToGeneralInfo Lines [commify $i] right
}

proc ::wt::fileBrowser::defaultPrintFile {} {
}

proc ::wt::fileBrowser::pathUrl {path {type file}} {
  variable baseUrl
  variable useDirectUrl

  if {$type != "directory" && $useDirectUrl && ![isViewable $path]} {
    set url "$baseUrl[file join / $path]"
  } else {
    set url [::wt::server::serverVars get REQUEST_URI]
    set url [::wt::web::setUrlParameters $url [list path $path] 1]
  }

  return $url
}

proc ::wt::fileBrowser::sysPath {subPath} {
  variable sysRoot
  file join $sysRoot [regsub "^\[/\\\\\]+" $subPath "./"]
}

proc ::wt::fileBrowser::printPathLinks {path type} {
  set links ""
  set cur ""
  set parts [file split $path]
  for {set i 0} {$i < [llength $parts]} {incr i} {
    if {$i > 0} {
      append links "&nbsp;"
    }
    if {$i > 1} {
      append links "/&nbsp;"
    }
    set part [lindex $parts $i]
    set label [shortenName $part 20]
    set cur [file join $cur $part]
    if {$i == [expr [llength $parts] - 1]} {
      set t $type
    } else {
      set t directory
    }
    set url [pathUrl $cur $t]
    append links "<a href=\"[::wt::web::htmlEncode $url]\">"
    append links "[::wt::web::htmlEncode $label]</a>"
  }
  return $links
}

proc ::wt::fileBrowser::viewHandler {path} {
  set ext [extension [fixBackupName [file tail $path]]]
  variable extensionHandlers
  if {[info exists extensionHandlers($ext)]} {
    return $extensionHandlers($ext)
  }

  variable patternHandlers
  foreach ptn [array names patternHandlers] {
    if {[regexp $ptn $path]} {
      return $patternHandlers($ptn)
    }
  }
}

proc ::wt::fileBrowser::isViewable {path} {
  if {[viewHandler $path] != ""} {
    return 1
  }
  return 0
}

proc ::wt::fileBrowser::extension {name} {
  set ext [file extension $name]
  if {[string index $ext 0] == "."} {
    set ext [string range $ext 1 end]
  }
  return $ext
}

proc ::wt::fileBrowser::shortenName {name max} {
  if {[string length $name] > $max} {
    return "[string range $name 0 [expr $max - 1]]..."
  }
  return $name
}

proc ::wt::fileBrowser::listDir {path} {
  if {$::tcl_platform(platform) == "windows"} {
    return [winDir $path]
  } else {
    set err "File browser not implemented on "
    append err "$::tcl_platform(platform) platform yet."
    error $err
  }
}

proc ::wt::fileBrowser::winDir {path} {
  set tmp [::wt::util::tmpFile]
  set fd [lindex $tmp 1]
  set cmd [list $::env(COMSPEC) /c dir /-C /N /Q /4 /ON $path >&@$fd]
  eval exec $cmd 
  flush $fd
  seek $fd 0 start
  set output [read $fd]
  close $fd
  file delete [lindex $tmp 0]

  set output [regsub "\r" $output ""]

  set lines [regexp -all -inline -lineanchor -- {^[0-9].*?$} \
    $output]
  if {[llength $lines] == 0} {
    # There should be at least one entry for "."
    error "Command \"dir\" failed: $output"
  }

  set entries {}
  foreach line $lines {
    set line [string trim $line]
    if {![regexp {(^\d\d/\d\d/\d\d\d\d\s+\d\d:\d\d\s+(AM|PM))\s+(.*?)\s+(.*?)\s+(.*)$} $line match time ap typeSize owner name]} {
      error "Unable to process command output."
    }
    set typeSize [string trim $typeSize]
    set type file
    set size ""
    if {[regexp {^[0-9]+$} $typeSize]} {
      set size $typeSize
    } elseif {$typeSize == "<DIR>"} {
      set type directory
    }
    set entry [table create \
      name [string trim $name] \
      type $type \
      modifiedTime [clock scan $time] \
      size $size \
      owner $owner]
    lappend entries $entry
  }

  return $entries
}

proc ::wt::fileBrowser::globDir {path} {
  set dirs [glob -directory $parentSysPath -nocomplain -tails *]
  set files [glob -directory $parentSysPath -nocomplain \
    -types {b c f p s} -tails *]

  set items {}
  foreach dir $dirs {
    lappend items [list $dir d]
  }
  foreach file $files {
    lappend items [list $file f]
  }
  set items [lsort -command sortDir $items]

  return $items
}

proc ::wt::fileBrowser::sortDir {x y} {
  return [string compare [lindex $x 0] [lindex $y 0]]
}

proc ::wt::fileBrowser::loadTypes {} {
  variable pkgDir
  set buf [::wt::util::readFile [file join $pkgDir mimeTypes.txt]]
  set buf [regsub -all -lineanchor {#.*?$} $buf ""]
  set lines [split [regsub -all -lineanchor {#[^#]*$} $buf ""] "\n"]

  variable mimeTypes
  array unset mimeTypes

  variable fileExtensions
  array unset fileExtesions

  variable textExtensions
  array unset textExtensions

  foreach line $lines {
    set mimeType [lindex $line 0]
    set family [string range $mimeType 0 [expr [string first / $mimeType] - 1]]
    set mimeTypes($mimeType) [lrange $line 1 end]
    set len [llength $line]

    for {set i 1} {$i < $len} {incr i} {
      set ext [lindex $line $i]
      lappend fileExtensions($ext) $mimeType
      if {$family == "text"} {
        lappend textExtensions($ext) $mimeType
      }
    }
  }
  
  variable loadedTypes
  set loadedTypes 1
}

proc ::wt::fileBrowser::fixBackupName {name} {
  if {[string index $name end] == "~"} {
    set fixedTailName [string trimright $name ~]
  } else {
    set fixedTailName [regsub {^#(.*)#$} $name {\1}]
  }
}

proc ::wt::fileBrowser::printHtml {} {
  variable viewHtml
  return $viewHtml
}

proc ::wt::fileBrowser::addBasicInfo {{showAccessedTime 0}} {
  variable elementProps
  if {[table get $elementProps type] != "directory"} {
    addSizeInfo
  }
  addModifiedInfo
  addCreatedInfo
  if {$showAccessedTime} {  
    addAccessedInfo
  }
  addOwnerInfo
  if {[table get $elementProps type] != "directory"} {
    addMimeInfo
  }
}

proc ::wt::fileBrowser::addSizeInfo {} {
  variable elementProps
  set sizeStr [commify [table get $elementProps size]]
  addToGeneralInfo Size [::wt::web::htmlEncode $sizeStr] right
}

proc ::wt::fileBrowser::addCreatedInfo {} {
  variable elementProps
  set time [table get $elementProps ctime]
  set time [clock format $time -format "%Y/%m/%d %H:%M:%S"]
  addToGeneralInfo "Created" [::wt::web::htmlEncode $time]
}

proc ::wt::fileBrowser::addModifiedInfo {} {
  variable elementProps
  set time [table get $elementProps mtime]
  set time [clock format $time -format "%Y/%m/%d %H:%M:%S"]
  addToGeneralInfo "Modified" [::wt::web::htmlEncode $time]
}

proc ::wt::fileBrowser::addAccessedInfo {} {
  variable elementProps
  set time [table get $elementProps atime]
  set time [clock format $time -format "%Y/%m/%d %H:%M:%S"]
  addToGeneralInfo "Accessed" [::wt::web::htmlEncode $time]
}

proc ::wt::fileBrowser::addOwnerInfo {} {
  variable elementProps
  addToGeneralInfo "Owner" \
    [::wt::web::htmlEncode [table get $elementProps owner]]
}

proc ::wt::fileBrowser::addMimeInfo {} {
  variable fileExtensions
  variable fixedExtension
  if {[info exists fileExtensions($fixedExtension)]} {
    set str [join $fileExtensions($fixedExtension) ", "]
    addToGeneralInfo "MIME Types" [::wt::web::htmlEncode $str]
  }
}

proc ::wt::fileBrowser::addToGeneralInfo {label value {alignment ""}} {
  variable generalInfo
  set item [table create \
    label $label value $value alignment $alignment]
  lappend generalInfo $item
}

proc ::wt::fileBrowser::formatMemSize {bytes} {
  if {$bytes < 0x3E8} {
    return "${bytes}"
  } elseif {$bytes < 0xF4240} {
    return "[expr round($bytes / 0x3E8)]k"
  } elseif {$bytes < 0x3B9ACA00} {
    return "[expr round($bytes / 0xF4240)]M"
  }
  return "[expr round($bytes / 0x3B9ACA00)]G"
}

# From http://aspn.activestate.com/ASPN/Cookbook/Tcl/Recipe/146220

proc ::wt::fileBrowser::commify {num {sep ,}} {
  while {[regsub {^([-+]?\d+)(\d\d\d)} $num "\\1$sep\\2" num]} {}
  return $num
}

package provide wt::fileBrowser 1
